﻿Imports System.Collections
Imports System.Collections.Generic
Imports System.Security.Cryptography
Imports System.Text
Imports System.Text.RegularExpressions
Imports System.Runtime.CompilerServices
Imports System.IO

Namespace Pop.Api.Util

    ''' <summary>
    ''' POP系统工具模块。
    ''' </summary>
    Public Module PopUtils

#Region "旧版鉴权"

        ''' <summary>
        ''' 给POP请求签名。
        ''' </summary>
        ''' <param name="parameters">所有字符型的POP请求参数</param>
        ''' <param name="ApiName">请求的Api名称</param>
        ''' <param name="secret">签名密钥</param>
        ''' <returns>签名</returns>
        ''' <remarks></remarks>
        <Extension()>
        Public Function GetSign(ByVal parameters As PopDictionary, ByVal apiName As String, ByVal secret As String) As String
            Return parameters.GetDictionary.GetSign(apiName, secret)
        End Function

        ''' <summary>
        ''' 给POP请求签名。
        ''' </summary>
        ''' <param name="parameters">所有字符型的POP请求参数</param>
        ''' <param name="ApiName">请求的Api名称</param>
        ''' <param name="secret">签名密钥</param>
        ''' <returns>签名</returns>
        ''' <remarks></remarks>
        <Extension()>
        Public Function GetSign(ByVal parameters As IDictionary(Of String, String), ByVal apiName As String, ByVal secret As String) As String
            ' 第一步：把字典按Key的字母顺序排序
            Dim sortedParams As IDictionary(Of String, String) = New SortedDictionary(Of String, String)(parameters)
            Dim dem As IEnumerator(Of KeyValuePair(Of String, String)) = sortedParams.GetEnumerator()

            ' 第二步：把所有参数名和参数值串在一起(前端加ApiName)
            Dim query As New StringBuilder(apiName)
            While dem.MoveNext()
                Dim key As String = dem.Current.Key
                Dim value As String = dem.Current.Value
                If Not String.IsNullOrEmpty(key) AndAlso Not String.IsNullOrEmpty(value) Then
                    query.Append(key).Append(value)
                End If
            End While

            ' 第三步：将secretKey添加到末尾
            query.Append(secret)

            ' 第四步：使用MD5加密
            Return query.ToString.ToMD5(Encoding.UTF8)
        End Function

        ''' <summary>
        ''' MD5加密
        ''' </summary>
        <Extension()>
        Public Function ToMD5(ByVal str As String, ByVal encod As Encoding) As String
            Dim bytHash() As Byte
            Using md5c As New MD5CryptoServiceProvider
                bytHash = md5c.ComputeHash(encod.GetBytes(str))
            End Using
            Dim sTemp As New StringBuilder
            For Each byt As Byte In bytHash
                sTemp.Append(byt.ToString("X").PadLeft(2, "0"c))
            Next
            Return sTemp.ToString.ToLower
        End Function

#End Region

#Region "新版鉴权"

        ''' <summary>
        ''' 新版鉴权
        ''' </summary>
        <Extension()>
        Public Function GetNewSign(ByVal parameters As PopDictionary, ByVal url As String, ByVal secret As String) As String
            Dim query As New StringBuilder

            '第1步：将请求的URI路径进行URL编码
            Dim uri As New Uri(url)
            Dim url_encode As String = uri.AbsolutePath.UrlEncode(Encoding.UTF8)

            '第2步：将除“sign”外的所有参数按key进行字典升序排列。
            parameters.Sort()

            '第3步：将第2步中排序后的参数(key=value)用&拼接起来，并进行URL编码。
            Dim field_encode As String = parameters.NewBuildQuery.UrlEncode(Encoding.UTF8)

            '第4步：将HTTP请求方式（GET或者POST）以及第1步和第3步中的字符串用&拼接起来。 
            query.Append("GET&")
            query.Append(url_encode).Append("&")
            query.Append(field_encode)

            Dim result As String = query.ToString.ToHMACSHA1(secret & "&")
            Return result
        End Function

        ''' <summary>
        ''' 新版权鉴组装普通文本请求参数。(GET组装请求)
        ''' </summary>
        ''' <param name="parameters">Key-Value形式请求参数字典</param>
        ''' <returns>组装后数据</returns>
        <Extension()>
        Public Function NewBuildQuery(ByVal parameters As PopDictionary) As String
            Dim postData As New StringBuilder
            Dim hasParam As Boolean = False
            '第2步：所有参数按key进行字典升序排列。
            parameters.Sort()
            Dim dem As IEnumerator(Of KeyValuePair(Of String, String)) = parameters.GetEnumerator()
            While dem.MoveNext()
                Dim name As String = dem.Current.Key
                Dim value As String = dem.Current.Value
                ' 忽略参数名或参数值为空的参数
                If Not String.IsNullOrEmpty(name) AndAlso Not String.IsNullOrEmpty(value) Then
                    If hasParam Then
                        postData.Append("&")
                    End If
                    postData.Append(name).Append("=").Append(value)
                    hasParam = True
                End If
            End While

            Return postData.ToString()
        End Function

        ''' <summary>
        ''' URL编码
        ''' 签名验证时，要求对字符串中除了“-”、“_”、“.”之外的所有非字母数字字符都替换成百分号(%)后跟两位十六进制数。
        ''' 十六进制数中字母必须为大写。
        ''' </summary>
        <Extension()>
        Public Function UrlEncode(ByVal str As String, ByVal e As Encoding) As String
            Dim bytes() As Byte = e.GetBytes(str)
            Dim stringWriter As New System.IO.StringWriter()
            For i = 0 To bytes.Length - 1
                Dim c As Byte = bytes(i)
                If c = 46 OrElse ((c >= 48) AndAlso (c <= 57)) OrElse ((c >= 65) AndAlso (c <= 90)) OrElse ((c >= 97) AndAlso (c <= 122)) Then
                    stringWriter.Write(CType(ChrW(c), Char))
                ElseIf c = 32 Then
                    stringWriter.Write("+")
                Else
                    stringWriter.Write("%{0:X2}", c)
                End If
            Next
            Return stringWriter.ToString()
        End Function

        ''' <summary>
        ''' HMAC-SHA1加密
        ''' </summary>
        ''' <param name="EncryptText">源串</param>
        ''' <param name="EncryptKey">密钥</param>
        <Extension()>
        Public Function ToHMACSHA1(ByVal encryptText As String, ByVal encryptKey As String) As String
            Dim hmacsha1 As New HMACSHA1
            hmacsha1.Key = System.Text.Encoding.ASCII.GetBytes(encryptKey)
            Dim dataBuffer As Byte() = System.Text.Encoding.ASCII.GetBytes(encryptText)
            Dim hashBytes As Byte() = hmacsha1.ComputeHash(dataBuffer)
            Return Convert.ToBase64String(hashBytes)
        End Function

#End Region

        ''' <summary>
        ''' 组装请求包的URL和参数、响应包的内容
        ''' </summary>
        <Extension()>
        Friend Function GetString(ByVal parameters As IEnumerable(Of KeyValuePair(Of String, String)), ByVal ReqUrl As String, ByVal Body As String)
            Dim strDesc As New StringBuilder("URL: ")
            strDesc.AppendLine(ReqUrl)
            strDesc.AppendLine("Params:")
            For Each item In parameters
                strDesc.AppendLine("    param name = " & item.Key & vbTab & "param value = " & item.Value)
            Next
            strDesc.AppendLine("Response:")
            strDesc.AppendLine(Body)
            Return strDesc.ToString
        End Function

#Region "组装包体"

        Private Const Boundary As String = "--------------------------------ThIs_Is_tHe_bouNdaRY_$"

        ''' <summary>
        ''' 组装HTTP请求包的包体内容
        ''' </summary>
        ''' <param name=" parameters">fields，参数列表</param>
        ''' <returns>包体内容</returns>
        <Extension()>
        Friend Function MultipartData(ByVal parameters As IEnumerable(Of KeyValuePair(Of String, String))) As Byte()
            Dim list As New List(Of Byte)
            Try
                For Each field In parameters
                    If True Then
                        If field.Key.Equals("charset") OrElse field.Key.Equals("sign") Then Continue For
                        list.AddRange(CByteStringField(field))
                    Else
                        'list.AddRange(CByteFileField(field))
                    End If
                Next
                list.AddRange(ToList(Encoding.UTF8.GetBytes("--" & Boundary & "--" & vbCrLf)))
            Catch ex As Exception
                MsgBox(ex.Message)
            End Try
            Return list.ToArray
        End Function

        Private Function CByteStringField(ByVal Field As KeyValuePair(Of String, String)) As List(Of Byte)
            Dim body As New StringBuilder
            body.Append("--" & Boundary & vbCrLf)
            body.Append("Content-Disposition: form-data; name=""" & Field.Key & """")
            body.Append(vbCrLf)
            body.Append("Content-Type: text/plain; charset=utf-8" & vbCr & vbLf)
            body.Append(vbCrLf)
            body.Append(Field.Value & vbCrLf)
            Return ToList(Encoding.UTF8.GetBytes(body.ToString))
        End Function

        Private Function CByteFileField(ByVal Field As FileField) As List(Of Byte)
            Dim body As New StringBuilder
            Dim list As New List(Of Byte)
            body.Append("--" & Boundary & vbCrLf)
            body.Append("Content-Disposition: form-data; name=""" & Field.Key & """")
            body.Append("; filename=""" & Field.Value & """" & vbCrLf)
            'body.Append("Content-Type: image/jpeg")
            body.Append("Content-Type: application/octet-stream" & vbCrLf)
            body.Append("Content-Transfer-Encoding: binary" & vbCrLf & vbCrLf)
            list.AddRange(ToList(Encoding.UTF8.GetBytes(body.ToString)))
            list.AddRange(CByteFileStream(Field.Value))
            Return list
        End Function

        Private Function CByteFileStream(ByVal FilePath As String) As List(Of Byte)
            Dim fileStream As New FileStream(FilePath, FileMode.Open, FileAccess.Read)
            Dim buffer(1024 * 2048 - 1) As Byte
            Dim memStream As New MemoryStream
            Dim bytesRead As Integer = 0
            Do
                bytesRead = fileStream.Read(buffer, 0, buffer.Length)
                memStream.Write(buffer, 0, bytesRead)
            Loop While bytesRead <> 0
            fileStream.Close()
            Return ToList(memStream.GetBuffer)
        End Function

        Private Function ToList(ByVal data() As Byte) As List(Of Byte)
            Dim list As New List(Of Byte)
            For Each d As Byte In data
                list.Add(d)
            Next
            Return list
        End Function

#End Region

#Region "组装包体2"

        ''' <summary>
        ''' 组装HTTP请求包的包体内容
        ''' </summary>
        ''' <param name=" parameters">参数列表</param>
        ''' <returns>包体内容</returns>
        <Extension()>
        Friend Function BuildQuery(ByVal parameters As IEnumerable(Of KeyValuePair(Of String, String))) As String
            Dim postData As New StringBuilder
            Dim dem As IEnumerator(Of KeyValuePair(Of String, String)) = parameters.GetEnumerator()
            While dem.MoveNext()
                Dim name As String = dem.Current.Key
                Dim value As String = dem.Current.Value
                ' 忽略参数名或参数值为空的参数
                If Not String.IsNullOrEmpty(name) AndAlso Not String.IsNullOrEmpty(value) Then
                    If name.Equals("charset") AndAlso name.Equals("sign") Then Continue While
                    postData.Append(dem.Current.CStrField)
                    'hasParam = True
                End If
            End While
            postData.AppendLine("--" & Boundary & "--")
            Return postData.ToString
        End Function

        <Extension()>
        Private Function CStrField(ByVal field As KeyValuePair(Of String, String)) As String
            Dim body As New StringBuilder
            body.AppendLine("--" & Boundary)
            body.AppendLine("Content-Disposition: form-data; name=""" & field.Key & """")
            body.AppendLine("Content-Type: text/plain; charset=utf-8")
            body.AppendLine()
            body.AppendLine(field.Value)
            Return body.ToString
        End Function
#End Region

    End Module

End Namespace